home *** CD-ROM | disk | FTP | other *** search
/* $VER: LhADir.StoneD 1.0 (18.11.95) Copyright © 1995 by Edmund Vermeulen This version by Stone-D (Laga Hale) Modified to co-exist with lzx version of same file by Stone-D. Placed in the public domain. No restrictions on distribution or usage. Usage differences with original : The original required you to change the lister buttons to link to the actual arexx script. Not so with this one. Change, for example, the COPY button from AREXX DOpus5:Rexx/LhADir.dopus5 {Qp} back to the COMMAND COPY. Do the same with MOVE, and DELETE. Make sure your lha filetype is configured to call lhadir.stoned, NOT lhadir.dopus5 ... no parameter change, just edit the line to lhadir.stoned EMail Stone-D at the following address : stone-d@eldar.demon.co.uk To make LhADir.Stone-D open it's own listview, refer to line 165 ARexx script for Directory Opus 5 to show the contents of an LhA archive in an Opus lister and operate on the files and directories inside the archive as if it is a normal directory, whilst allowing simultaneous access to similiar scripts...such as the lzxdir.dopus5 one. */ ver='$VER: LhADir.StoneD 1.0' /* for compiled version */ signal on syntax /* intercept syntax errors */ options results /* need results */ options failat 21 /* external commands are allowed return code 20 */ numeric digits 10 /* needed for convertdate routine */ lf='0a'x /* ascii code for linefeed */ if ~show('l','rexxsupport.library') then call addlib('rexxsupport.library',0,-30) /* needed for delay() */ /* init locale */ ok=show(l,'locale.library') if ~ok then ok=addlib('locale.library',0,-30) if ok then catalog=opencatalog('LhADir.catalog','english',0) parse arg cmd portname . '"' dblclck '"' handle . upper cmd if portname~='' then address value portname else portname=address() parse var portname '.' portno /* port number */ if handle='' then do lister query source if rc>0 then call quitit parse var result handle . /* only need first source */ end lister query handle numselentries entries=result if dblclck~=='' then do entries=1 if right(dblclck,1)='/' then do filetype=1 selentry=left(dblclck,length(dblclck)-1) end else do filetype=-1 selentry=dblclck end end else if entries>0 then call getfirstone call checklhadir(handle) topline='' listlha=0 notmove=cmd~='MOVE' select when cmd='GETDIR' then call dogetdir when cmd='BROWSE' then call dogetdir when cmd='GETSIZES' then call dogetsizes when cmd='DELETE' then call dodelete when cmd='COPY' then call docopy when cmd='MOVE' then call docopy when cmd='MAKEDIR' then call domakedir otherwise if lhadir then do lister select handle '"'selentry'"' off lister refresh handle address command 'LhA e -q -x2 -Qo "'patch(lhafile,0)'" T: "'patch(lhasubdir||selentry,1)'"' if rc>0 then call quitit(getcatstr(11,'Error while extracting from archive.')) thisfile='"T:'selentry'"' command cmd thisfile lister wait handle do until rc~=20 /* keep trying until not in use */ call delay(200) address command 'Delete >NIL:' thisfile 'QUIET' end end else command cmd end call quitit(topline) /* finished */ dogetdir: if ~show('p','LhaDirStoneD-handler'portno) then address command 'Run >NIL: <NIL: rx DOpus5:arexx/LhaDirStoneD-handler' portname oldlhadir=lhadir if entries>0 then if filetype>0 then /* list a new dir */ if lhadir then lhasubdir=lhasubdir||selentry'/' else winpath=winpath||selentry'/' else do /* list an archive file */ if pos('|'upper(right(selentry,4)'|'),'|.LHA|.LZH|.RUN|')=0 then call quitit(getcatstr(18,'Sorry, LhADir.StoneD can only'lf'list LhA archives.')) if lhadir then do lister query dest if rc>0 then call quitit(getcatstr(9,'No destination selected!')) parse var result desthandle . lister query desthandle path destpath=result dopus request '"'getcatstr(20,'This is an archive in an archive.'lf||lf'Extract it to'lf"'%s'"lf'and then list it?',destpath)'"' getcatstr(21,'Extract|Cancel') if ~rc then call quitit address command 'LhA e -q -x2 -a -C0 -Qo "'patch(lhafile,0)'" "'destpath'" "'patch(lhasubdir||selentry,1)'"' if rc>0 then call quitit(getcatstr(11,'Error while extracting from archive.')) lister read desthandle '"'destpath'"' force lhafile=destpath||selentry end else lhafile=winpath||selentry lhadir=1 lhasubdir='' listlha=1 end lister select handle '"'selentry'"' off lister refresh handle if lhadir then do if cmd='BROWSE' then do oldhandle=handle /* The Following makes LhaDir open it's own lister window. Uncomment to make this true */ /* lister new */ /* handle=result */ lister set handle title getcatstr(0,'LhADir listed archive') lister set handle source address command 'Copy >NIL: T:LhADir.list'oldhandle 'T:LhADir.list'handle end else do if ~oldlhadir then lister empty handle /* use a new cache */ lister set handle title getcatstr(0,'LhADir listed archive') end call showlhadir end else if cmd='BROWSE' then command scandir new winpath else do if entries=0 then winpath='' command scandir winpath end return dodelete: askdelete=1 if lhadir then do if entries=0 then call quitit if notmove then do lister set handle busy on if askdelete then do lister query handle numselfiles nfiles=result lister query handle numseldirs ndirs=result dopus request '"'getcatstr(5,'Warning: you cannot get back'lf'what you delete! OK to delete:'lf||lf'%s file(s) and'lf'%s drawer(s) (and their contents)?',nfiles,ndirs)'"' getcatstr(6,'Proceed|Cancel') if ~rc then call quitit end call getall end call open('actionfile','T:actionfile'handle,'w') do i=1 to entries if type.i>0 then wild='/#?' else wild='' call writeln('actionfile','"'patch(lhasubdir||name.i,1)||wild'"') lister remove handle '"'name.i'"' end call close('actionfile') lister set handle progress '-1' getcatstr(7,'Deleting from archive...') address command 'LhA d -q -Qp -Qo "'patch(lhafile,0)'" @T:actionfile'handle if rc>0 then do topline=getcatstr(8,'Error while deleting from archive.') listlha=1 call showlhadir end else lister refresh handle address command 'Delete >NIL: T:actionfile'handle 'QUIET' address command 'Delete >NIL: T:LhADir.list'handle 'QUIET' /* archive has changed */ lister set handle busy off end else do command delete lister wait handle end return docopy: if entries=0 then call quitit problem=0 src=winpath s_lhadir=lhadir s_lhafile=lhafile s_lhasubdir=lhasubdir lister query dest if rc>0&lhadir then call quitit(getcatstr(9,'No destination selected!')) parse var result desthandle . /* only need first destination */ call checklhadir(desthandle) if s_lhadir then do lister set handle busy on lister set desthandle busy on if lhadir then winpath='T:LhADir'handle'/'lhasubdir call getall call lhaextract if lhadir then do src=winpath call lhaadd end else if problem then do lister set desthandle busy off lister read desthandle '"'destpath'"' force end else do do i=1 to entries lister query handle entry '"'name.i'"' stem fileinfo. if fileinfo.type>0 then fileinfo.size=0 lister add desthandle '"'name.i'"' fileinfo.size fileinfo.type fileinfo.date fileinfo.protstring fileinfo.comment end lister refresh desthandle end end else if lhadir then do lister set handle busy on if ~notmove then do cuthere=lastpos('/',lhafile) if cuthere=0 then cuthere=pos(':',lhafile) name=substr(lhafile,cuthere+1) if left(lhafile,length(src))==src then do name=substr(lhafile,length(src)+1) parse var name name '/' lister query handle entry '"'name'"' stem fileinfo. if fileinfo.selected then call quitit(getcatstr(19,'You can''t move an archive into itself!')) end end lister set desthandle busy on call getall call lhaadd end else do /* normal copy or move */ if notmove then command copy else command move lister wait handle end lister set handle busy off lister set desthandle busy off if (s_lhadir|lhadir)&~notmove&~problem then do lhadir=s_lhadir lhafile=s_lhafile lhasubdir=s_lhasubdir lister query handle abort if result then call quitit(getcatstr(3,'Aborted...')) lister set handle busy off lister wait handle call dodelete end return dogetsizes: if lhadir then do lister set handle busy on lister set handle progress '-1' getcatstr(14,'Scanning directories...') lister query handle numseldirs ndirs=result lister query handle seldirs stem dname. n=1 do i=0 to dname.count-1 dirname.n=dname.i lister query handle entry '"'dirname.n'"' stem fileinfo. if fileinfo.size=0 then n=n+1 end dirsize.=0 dirsecs.=0 ndirs=n-1 call readlist(0) lister set handle busy off end else command getsizes return domakedir: lister set handle busy on dopus getstring '"'getcatstr(15,'Enter directory name or archive name.lha')'" 31 ""' getcatstr(16,'OK|Cancel') dirtomake=result if dirtomake==''|dirtomake='RESULT' then call quitit now=date('i')*86400+time('s') if lhadir then do /* create empty dir in archive */ call createdirs(dirtomake'/') address command 'LhA a -q -e -r -Qo "'patch(lhafile,0)'" T:LhADir'handle'/' '"'patch(lhasubdir||dirtomake,1)'"' if rc>0 then topline=getcatstr(13,'Error while adding to archive.') else do lister add handle '"'dirtomake'" -1 1' now '----rwed' lister refresh handle end address command 'Delete >NIL: T:LhADir'handle 'ALL QUIET' address command 'Delete >NIL: T:LhADir.list'handle 'QUIET' end else if upper(right(dirtomake,4))=='.LHA' then /* create new archive */ if open('emptyarchive',winpath||dirtomake,'w') then do call writech('emptyarchive','0'x) call close('emptyarchive') command protect 'NAME "'winpath||dirtomake'" CLEAR e' lister add handle '"'dirtomake'" 1 -1' now '----rw-d' lister refresh handle end else topline=getcatstr(17,'Error creating archive.') else do /* normal makedir */ lister set handle busy off command makedir 'NOICON NAME "'dirtomake'"' end return showlhadir: lister clear handle lister set handle busy on lister set handle progress '-1' getcatstr(1,'Listing archive...') lister set handle handler 'LhaDirStoneD-handler'portno lister set handle path lhafile'/'lhasubdir lister refresh handle full now=date('i')*86400+time('s') ndirs=0 call readlist(1) return readlist: arg show /* showdir or getsizes? */ if ~exists(lhafile) then call quitit(getcatstr(22,'Error, archive not found.')) if listlha|~exists('T:LhADir.list'handle) then call lhalist call open('tempfile','T:LhADir.list'handle,'r') do 3 call readln('tempfile') /* waste the first 3 lines */ end compstr=upper(lhasubdir) complen=length(compstr) nextline=readln('tempfile') do forever name=nextline infoline=readln('tempfile') do while pos('% ',infoline)<22 name=infoline infoline=readln('tempfile') end if name=='-------- ------- ----- --------- --------' then leave nextline=readln('tempfile') if left(nextline,1)==':' then do parse var nextline 3 comment nextline=readln('tempfile') end else comment='' if upper(left(name,complen))==compstr then do name=substr(name,complen+1) if name~==''&pos('"',name)=0 then do if pos('/',name)>0 then do /* it's a dir */ parse var name dirname '/' olddir=0 i=ndirs+1 do while i>1&~olddir i=i-1 olddir=upper(dirname)==upper(dirname.i) end if olddir&~show then do call convertdate dirsize.i=dirsize.i+size if seconds>dirsecs.i then dirsecs.i=seconds end if show&~olddir then do /* a new dir */ ndirs=ndirs+1 dirname.ndirs=dirname lister add handle '"'dirname'" -1 1' now '----rwed' end end else /* it's a file */ if show then do call convertdate lister add handle '"'name'"' size '-1' seconds atts comment end end end end call close('tempfile') if ~show then do i=1 to ndirs lister add handle '"'dirname.i'"' dirsize.i '1' dirsecs.i '----rwed' lister select handle '"'dirname.i'"' on end lister refresh handle full return checklhadir: arg checkhandle lister query checkhandle path winpath=result test=upper(winpath) cuthere=pos('.LHA/',test) if cuthere=0 then cuthere=pos('.LZH/',test) if cuthere=0 then cuthere=pos('.RUN/',test) lhadir=cuthere>0 if lhadir then do lhafile=left(winpath,cuthere+3) lhasubdir=substr(winpath,cuthere+5) end return lhaextract: lister query handle numdirs anydirs=result>0 mustmove=anydirs&s_lhasubdir~=='' if mustmove then destpath=winpath'LhADir'handle'/' else destpath=winpath call open('actionfile','T:actionfile'handle,'w') do i=1 to entries if type.i>0 then wild='/#?' else wild='' call writeln('actionfile','"'patch(s_lhasubdir||name.i,1)||wild'"') end call close('actionfile') if anydirs then lhacmd='x' else lhacmd='e -x2' lister set handle progress '-1' getcatstr(10,'Extracting from archive...') address command 'LhA' lhacmd '-q -a -C0 -Qo "'patch(s_lhafile,0)'" "'destpath'" @T:actionfile'handle problem=rc>0 if problem then topline=getcatstr(11,'Error while extracting from archive.') else if notmove then do do i=1 to entries lister select handle '"'name.i'"' off end lister refresh handle end if mustmove then do address command 'Rename >NIL: "'winpath'LhADir'handle'/'s_lhasubdir'#?" "'winpath'" QUIET' address command 'Delete >NIL: "'winpath'LhADir'handle'" ALL QUIET' end address command 'Delete >NIL: T:actionfile'handle 'QUIET' return lhaadd: mustcopy=upper(right(src,length(lhasubdir)))~==upper(lhasubdir) if mustcopy then do /* all files must be copied to T: before they can be added */ homedir='T:LhADir'handle'/' call createdirs end else homedir=left(src,length(src)-length(lhasubdir)) call open('actionfile','T:actionfile'handle,'w') call writeln('actionfile','"'patch(homedir,0)'"') if s_lhadir then call writeln('actionfile','#?') else do do i=1 to entries call writeln('actionfile','"'patch(lhasubdir||name.i,0)'"') if mustcopy then address command 'Copy "'src||name.i'" "T:LhADir'handle'/'lhasubdir'"' end end call close('actionfile') if pos('.LZH/',test)>0 then method='-0' else method='' lister set desthandle progress '-1' getcatstr(12,'Adding to archive...') address command 'LhA r' method '-q -e -r -Qo "'patch(lhafile,0)'" @T:actionfile'handle problem=rc>0 if problem then topline=getcatstr(13,'Error while adding to archive.') else if notmove then do do i=1 to entries lister select handle '"'name.i'"' off end lister refresh handle end address command 'Delete >NIL: T:actionfile'handle 'QUIET' if mustcopy|s_lhadir then address command 'Delete >NIL: T:LhADir'handle 'ALL QUIET' call swapactive listlha=1 call showlhadir call swapactive return lhalist: address command 'LhA >T:LhADir.list'handle 'vv -N -Qw -Qo "'lhafile'"' if rc>0 then call quitit(getcatstr(2,'Error while listing archive.')) return swapactive: swaphandle=handle handle=desthandle desthandle=swaphandle return createdirs: parse arg subdir dirstocreate='T:LhADir'handle'/'lhasubdir||subdir here=0 mdstring='' do until here=0 here=pos('/',dirstocreate,here+1) if here>0 then mdstring=mdstring '"'left(dirstocreate,here-1)'"' end address command 'MakeDir >NIL:' mdstring return getall: lister query handle numseldirs ndirs=result lister query handle seldirs do n=1 to ndirs parse var result '"' name.n '"' result type.n=1 end lister query handle numselfiles nfiles=result lister query handle selfiles do n=ndirs+1 to ndirs+nfiles parse var result '"' name.n '"' result type.n=-1 end entries=ndirs+nfiles return convertdate: /* convert a file's datestamp to seconds past 01-Jan-78 */ parse var infoline size . '% ' day '-' month '-' year ' ' hours ':' minutes ':' seconds atts . minus=day='00' if minus then day='01' century=19+(year<78) month=pos(month,' JanFebMarAprMayJunJulAugSepOctNovDec')/3 month=right(month,2,'0') if month='00' then month='01' seconds=seconds+minutes*60+hours*3600+(date('i',century||year||month||day,'s')-minus)*86400 return getfirstone: lister query handle firstsel selentry=result lister query handle entry selentry stem fileinfo. selentry=fileinfo.name filetype=fileinfo.type return patch: /* patch filenames containing strange characters */ parse arg patched,apostrophe verstr='*#?|%()[]~' if apostrophe then verstr=verstr"'" pos=1 do until here=0 here=verify(substr(patched,pos),verstr,'m') if here>0 then do pos=pos+here+1 patched=insert("'",patched,pos-3) end end if left(patched,1)='@' then patched='*'patched return patched getcatstr: parse arg msgno,msgstring,insert.1,insert.2 if catalog~=0 then msgstring=getcatalogstr(catalog,msgno,msgstring) i=0 do while pos('%s',msgstring)>0 parse var msgstring fore '%s' aft i=i+1 msgstring=fore||insert.i||aft end return msgstring syntax: call quitit('Syntax Error' rc',' errortext(rc) 'in line' sigl'.') quitit: parse arg topline lister clear handle progress lister set handle busy off if catalog~=0 then call closecatalog(catalog) if topline~=='' then dopus request '"'topline'"' getcatstr(4,'OK') exit 
